Shareware Grab Bag/Shareware Grab Bag.iso/005/signup.arc/SIGNUP.PAS

Pascal/Delphi Source File | 1985-06-22 | 55.5 KB | 1,624 lines

{Program SIGN UP! by James Edmunds                         }
{Written in Turbo Pascal, originally for the purpose of    }
{easing registration of youngsters into summer workshops   }
{at Iberia Parish Library, and one copy donated to that    }
{library. This program may be copied and used freely; if   }
{you like and use the program, you are requested to send   }
{25.00 to James Edmunds, PO Box 2185, New Iberia, LA 70560 }



program SignUp;

const
    MaxNoWorkshops = 45;
    MaxNoParticpants = 100;


type
    WorkshopName = string[18];
    WorkshopTime = string[40];
    Instructor = string[25];
    Schedule = record
                WorkshopNumber: Integer;
                Workshop: WorkshopName;
                When: WorkshopTime;
                Who: Instructor;
                HowMany: Integer;
                YoungestAge: Integer;
                OldestAge: Integer;
               end;
    ParticName = string[30];
    ParticAddr1 = string[30];
    ParticAddr2 = string[30];
    ParticAddr3 = string[30];
    ParticPhone = string[14];
    Participant = record
                     PartiNumber: Integer;
                     PartiName: ParticName;
                     PartiAddr1: ParticAddr1;
                     PartiAddr2: ParticAddr2;
                     PartiAddr3: ParticAddr3;
                     PartiPhone: ParticPhone;
                     PartiAge: Integer;
                     PartiIn1: Integer;
                     PartiIn2: Integer;
                     PartiIn3: Integer;
                     PartiIn4: Integer;
                     PartiIn5: Integer;
                     PartiIn6: Integer;
                     PartiIn7: Integer;
                     PartiIn8: Integer;
                     PartiIn9: Integer;
                     PartiIn10: Integer;
                     AltIn1: Integer;
                     AltIn2: Integer;
                     AltIn3: Integer;
                     AltIn4: Integer;
                     AltIn5: Integer;
                     AltIn6: Integer;
                     AltIn7: Integer;
                     AltIn8: Integer;
                     AltIn9: Integer;
                     AltIn10: Integer;
                  end;
     RosterListing = record
                        PartiRosterNumber: Integer;
                        PartiRosterName: ParticName;
                        PartiRosterPhone: ParticPhone;
                        AltFlag: Boolean;
                     end;

     Limit = record
                 WorkshopLimit: Integer;
                 AlternateLimit: Integer;
             end;


var
   SchedFile : file of Schedule;
   SchedRec: Schedule;
   PartiFile: file of Participant;
   PartiRec: Participant;
   RostListFile: file of RosterListing;
   RostRec: RosterListing;
   LimitFile : file of Limit;
   LimitRec : Limit;
   MostWorkshops, MostAlternates: Integer;
   WorkshopChoice,NumberIn,NumberAltIn,PartiAgeHold,A,B,C,D: Integer;
   Number,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z: Integer;
   Choice,Choic,Ch : char;
   Yes, Stopper, Okay, IsOne, PrintReg, AltFlagger, FormFeed,Beep : Boolean;
   AgeSkip : Boolean;
   CheckForFile : file;
   Entry: string[80];
   RosterNumber: string[3];
   RosterName: string[8];
   Expression: string[80];
   PartiNameHold: string[30];
   PartiAddr1Hold: string[30];
   PartiAddr2Hold: string[30];
   PartiAddr3Hold: string[30];
   PartiPhoneHold: string[30];
   WhichIn: string[1];
   WhichAlt: string[1];





{Draw the opening screen. Use TextColor and BackgroundColor to}
{make display in reverse video.                               }

procedure DrawScreen;
begin
          ClrScr;
          TextColor(0);
          TextBackground(7);
          for I := 1 to 23 do
          begin
               Writeln('     SIGN UP!       SIGN UP!       SIGN UP!       SIGN UP!       SIGN UP!     ');

          end;
                 Write('     SIGN UP!       SIGN UP!       SIGN UP!       SIGN UP!       SIGN UP!     ');
          TextColor(7);
          TextBackground(0);
end;

{A cheap explosion effect}

procedure MakeWindow;
begin
      Window(29,10,50,15);
      ClrScr;
      Delay(500);
      Window(22,8,57,17);
      ClrScr;
      Delay(500);
      Window(14,6,64,19);
      ClrScr;
      Delay(500);
      Window(7,4,71,21);
      ClrScr;
      Delay(500);
      Window(5,3,73,22);
      ClrScr;
      Delay(500);
      Window(3,2,76,23);
      ClrScr;
      end;

{Title of the program and the egomaniac programmer's name.}

procedure Title;
      begin
      For I:= 1 to 6 do
      Writeln;
      Writeln('                              SIGN UP!');
      Writeln;
      Writeln;
      Writeln;
      Writeln;
      Writeln('                                 by');
      Writeln('                            James Edmunds');
      Writeln('                             PO Box 2185');
      Writeln('                            New Iberia, LA');
      Writeln('                                70560');
      end;




{Checks to see if a file already exists}
procedure CheckForTheFile;
     begin
     {$I-} Reset(CheckForFile) {$I+};  {Reset is an error if no file exists}
     IsOne := (IOresult = 0);
     end;





procedure Greeting;
          begin
               Assign(CheckForFile,'SKED.DTA');
               CheckForTheFile;
               If not IsOne then
               begin
                    ClrScr;
                    Writeln(^G);
                    Writeln('   This program allows the creation of a schedule of');
                    Writeln('   up to 45 workshops, registration of participants');
                    Writeln('   into those workshops, the printing of a complete');
                    Writeln('   registration list, the onscreen viewing or printing');
                    Writeln('   of individual workshop rosters, the limitation ');
                    Writeln('   of class size and the listing of registrants as');
                    Writeln('   alternates in classes that are full. It blocks');
                    Writeln('   registration of participants not in the proper');
                    Writeln('   age range but allows the registrar to override');
                    Writeln('   the age limitation on an individual basis. Parti-');
                    Writeln('   cipants are limited in the number of workshops for');
                    Writeln('   which they may register and also for which they may');
                    Writeln('   may be listed as alternates. Those limits are set');
                    Writeln('   for the entire schedule by the registrar. The entire');
                    Writeln('   program is menu-driven.');
                    Writeln;
                    Writeln('   (Press the space bar for more...)');
                    Read(KBD,Ch);
                    ClrScr;
                    Writeln;
                    Writeln('   It is advised that you begin by using a disk with only');
                    Writeln('   the files with names beginning with "SIGNUP" and "COMMAND"');
                    Writeln('   to run this program, as the program itself creates 48');
                    Writeln('   additional files and all the disk space is needed');
                    Writeln('   for data storage. When you wish to create an additional');
                    Writeln('   schedule--next session, for instance--it is suggested');
                    Writeln('   that you copy SIGNUP.COM (only!) onto a new, blank disk.');
                    Writeln;
                    Writeln;
                    Writeln('   If you use this program and find it valuable, you are');
                    Writeln('   asked to send 25.00 to James Edmunds, PO Box 2185, New Iberia,');
                    Writeln('   Louisiana, 70560.');
                    Write('   Do you wish a printout of that name and address? (Y/N) ');
                    Repeat
                          Read(KBD,Ch);
                    Until UpCase(Ch) in ['Y','N'];
                    Writeln(UpCase(Ch));
                    If UpCase(Ch) = 'Y' then
                    begin
                         Writeln(Lst,'If you use SIGNUP and find it valuable, please');
                         Writeln(Lst,'send 25.00 to:');
                         Writeln(Lst,'     James Edmunds');
                         Writeln(Lst,'     PO Box 2185');
                         Writeln(Lst,'     New Iberia, LA  70560');
                    end;
                    Writeln;
                    Writeln('   In no event does the programmer undertake any liability');
                    Writeln('   with the regard to the performance of the program');
                    Writeln('   or any situation arising from its use.');
                    Writeln;
                    Delay(3000);
                    Write(^G);
                    Write('   Press the space bar to continue...');
                    Read(KBD,Ch);
               end;
          end;






{The procedure lumping all the introductory stuff together}
procedure Intro;
begin
     DrawScreen;
     Delay(500);
     MakeWindow;
     Delay(250);
     Title;
     Delay(4000);
     Greeting;
end;


{General purpose procedure to get an expression with regard to limit of}
{length of string. Called with C=Column, R=Row, L=Length limit of      }
{expression. Carriage return--Chr(13)--enters the expression into      }
{desired location in calling routine. This is for strings.             }
procedure GetExpression;
     begin
         Expression := '';
         GotoXY(C,R);
         Write('':L,'<<');
         GotoXY(C,R);
         Repeat
         Read(KBD,Ch);
         Expression := Expression + Ch; {Add each keystroke to string}
         J := Length(Expression);
         If Ch = Chr(8) then {Special routing for backspaces}
         begin
            If J = 1 then  {Special routine for backspace as first Ch}
            begin
              Write(^G);
              Delete(Expression,J,1);
            end;
            If J <> 1 then
            begin
              Delete(Expression,J-1,2);
              M := (C + (J - 2));
              GotoXY(M,R);
              Write(' ');
              J := J - 1;
            end;
         end;
         GotoXY(C,R);
         Write(Expression);
         If Ch = Chr(13) then L := L + 1;
         If J > L then
         begin
              Write(^G); {Wipes it out with a beep if too long}
              Expression := '';
              GotoXY(C,R);
              Write('':L,'<<      ');
         end;
         Until Ch = Chr(13);
     end;

{Similar to GetExpression, but uses X as number length. Case of routine}
{averts variable type error by locking out anything but numbers, back- }
{spaces and Carriage returns}
procedure GetNumber;
     begin
         Expression := '';
         GotoXY(C,R);
         Write('':X,'<<');
         GotoXY(C,R);
         Repeat
               Repeat
                   Beep := True; {Locks out letters, etc. Beeps if wrong}
                   Read(KBD,Ch); {kind of key pressed}
                   If Ch in ['0','1','2','3','4','5','6','7','8','9',Chr(8),Chr(13)] then
                   begin
                       Beep := False;
                   end;
                   If Beep = True then Write(^G);
               Until Ch in ['0','1','2','3','4','5','6','7','8','9',Chr(8),Chr(13)];
               Expression := Expression + Ch;
               J := Length(Expression);
               If Ch = Chr(8) then
               begin
                  If J = 1 then
                  begin
                    Write(^G);
                    Delete(Expression,J,1);
                  end;
                  If J <> 1 then
                  begin
                    Delete(Expression,J-1,2);
                    M := (C + (J - 2));
                    GotoXY(M,R);
                    Write(' ');
                    J := J - 1;
                 end;
              end;
              GotoXY(C,R);
              Write(Expression);
              If Ch = Chr(13) then X := X + 1;
              If J > X then
              begin
                   Write(^G);
                   Expression := '';
                   GotoXY(C,R);
                   Write('':X,'<<      ');
              end;
              Until Ch = Chr(13);
              Val(Expression,K,O);
              Number := K;
     end;




{Initializes SKED.DTA,etc. and moves to EditSched}
procedure MakeSched;
     begin
     Writeln;
     Writeln;
     Writeln;
     TextColor(15);
     Writeln('        There is no schedule file on this disk.');
     Writeln;
     Write('        Do you wish to create a schedule? (Y/N) ');
     Read(KBD,Choice);
     Repeat until UpCase(Choice) in ['Y','N'];  {Falls through to menu on N}
     Writeln(Choice);
     Choic := UpCase(Choice);
     If Choic = 'Y' then
        begin
           Writeln;
           Writeln;
           Writeln('        Please wait a moment while the program prepares');
           Writeln('        the disk so that you may create a schedule.');
           Assign(SchedFile,'SKED.DTA');
           Rewrite(SchedFile);
           with SchedRec do
           begin
             Workshop := '                  ';
             When := ''; Who := ''; HowMany := 0; YoungestAge :=0; OldestAge := 0;
             for I := 1 to MaxNoWorkshops do
             begin
                  WorkshopNumber := I;
                  Write(SchedFile,SchedRec);
             end;
           end;
           Close(SchedFile);
           Assign(PartiFile,'PARTI.DTA');
           Rewrite(PartiFile);
           Close(PartiFile);
           For I := 10 to 55 do   {Use 10 to 55 instead of 1 to 45 so Str function}
           begin                  {can use 2 places consistently}
               Str(I:2,RosterNumber);
               RosterName := 'ROS.' + RosterNumber;
               Assign(RostListFile,RosterName);
               Rewrite(RostListFile);
               Close(RostListFile);
           end;
         TextColor(7);
         ClrScr;
         Writeln;
         Writeln;
         Writeln;
         Writeln('    Now, you must set a limit on the number of workshops');
         Writeln('    for which each participant will be allowed to register.');
         Writeln('    You may set that number as high as 10.');
         Write('    Enter the maximum number of workshops per registrant:');
         Repeat
            Repeat
               Repeat
                 C := 62; R := 7; X := 2;
                 GetNumber;
                 If Number > 10 then Write(^G);
                 If Number < 1 then Write(^G);
               Until Number < 11;
            Until Number > 0;
            GotoXY(8,1);
            Write('':69);
            GotoXY(8,1);
            Write('               Are you sure? (Y/N)');
            Repeat
                  Read(KBD,Ch);
            Until UpCase(Ch) in ['Y','N'];
            Write(UpCase(Ch));
         Until UpCase(Ch) = 'Y';
         MostWorkshops := Number;
         ClrScr;
         Writeln;
         Writeln('    The program automatically registers participants as');
         Writeln('    alternates when requested workshops are already full.');
         Writeln('    You must specify the number of workshops for which one');
         Writeln('    may register as an alternate. The minimum is 1, and the');
         Writeln('    number may be as high as 10.');
         Write('    Enter the maximum number for alternate listings:');
         Repeat
            Repeat
               Repeat
                 C := 62; R := 7; X := 2;
                 GetNumber;
                 If Number > 10 then Write(^G);
                 If Number < 1 then Write(^G);
               Until Number < 11;
            Until Number > 0;
            GotoXY(8,1);
            Write('':69);
            GotoXY(8,1);
            Write('               Are you sure? (Y/N)');
            Repeat
                  Read(KBD,Ch);
            Until UpCase(Ch) in ['Y','N'];
            Write(UpCase(Ch));
         Until UpCase(Ch) = 'Y';
         MostAlternates := Number;
         Assign(LimitFile,'LIMITS.DTA');ReWrite(LimitFile);
         With LimitRec do
         begin
              WorkshopLimit := MostWorkshops;
              AlternateLimit := MostAlternates;
         end;
         Write(LimitFile,LimitRec);
         Close(LimitFile);
         ClrScr;
       end;
     end;



procedure EditMessage;
      begin
          GotoXY(1,1);
          Writeln('     Each workshop is assigned a number. To add a workshop, type in a');
          Writeln('     number that has no name next to it and press <RETURN>.');
          Writeln('     To edit information about a workshop that is listed, type the number');
          Writeln('     to the left of its name and press <RETURN>.');
          Writeln('     To exit from this function, type 0 and press <RETURN>.');
      end;


procedure RosterMessage;
       begin
            GotoXY(1,1);
            Writeln('    Each workshop is assigned a number. To choose the');
            Writeln('    workshop whose roster you wish to examine, type the');
            Writeln('    number to the left of its name and press <RETURN>.');
            Writeln('    To exit from this function, type 0 and press <RETURN>.');
       end;





{Put the list of workshops on the screen and choose one to enter/edit}
procedure ListWorkshops;
     begin
          for I := 1 to 74 do
          begin
               GotoXY(I,6);
               Write(chr(205));
          end;
          Assign(SchedFile,'SKED.DTA');Reset(SchedFile);
          for I := 1 to 9 do
          begin
               J := I + 6;       {Two routines in left-most column to}
               GotoXY(4,J);      {keep numbers right-justified}
               Write(I);
               Seek(SchedFile,I-1); Read(SchedFile,SchedRec);
               with SchedRec do
               begin
                   GotoXY(6,J);
                   Write(Workshop);
               end;
          end;
          for I := 10 to 15 do
          begin
               J := I + 6;
               GotoXY(3,J);
               Write(I);
               Seek(SchedFile,I-1); Read(SchedFile,SchedRec);
               with SchedRec do
               begin
                   GotoXY(6,J);
                   Write(Workshop);
               end;
          end;
          for I := 16 to 30 do {routine to display second column}
          begin
               J := I-9;
               GotoXY(27,J);
               Write(I);
               Seek(SchedFile,I-1); Read(SchedFile,SchedRec);
               with SchedRec do
               begin
                    GotoXY(30,J);
                    Write(Workshop);
               end;
          end;
          for I := 31 to 45 do    {third column}
          begin
               J := I-24;
               GotoXY(51,J);
               Write(I);
               Seek(SchedFile,I-1); Read(SchedFile,SchedRec);
               with SchedRec do
               begin
                    GotoXY(54,J);
                    Write(Workshop);
               end;
          end;
          TextColor(15);
          Repeat
          GotoXY(40,22);
          Write('CHOICE: ');
          C := 48; R := 22; X := 2; {Set location variables prior to calling}
          GetNumber;
          WorkshopChoice := Number;
          If 45 < WorkshopChoice then
          begin
               GotoXY(1,1);
               Sound(440);
               Delay(300);
               NoSound;
               GotoXY(3,22);
               Write('You must enter a number from 1 to 45, or 0 to exit. Try Again.');
               Delay(5000);
               GotoXY(3,22);
               Write('':69);
          end;
          Until 46 > WorkshopChoice;   {0 falls through to menu}
          Close(SchedFile);
          TextColor(7);
      end;



{Enter or edit a workshop}
procedure EditWorkshop;
      begin
           ClrScr;
           GotoXY(4,10);
           Write('Workshop Title: ');
           GotoXY(4,11);
           Write('  Time & Place: ');
           GotoXY(4,12);
           Write('    Instructor: ');
           GotoXY(4,13);
           Write('   Class limit: ');
           GotoXY(4,14);
           Write('   Minimum age: ');
           GotoXY(4,15);
           Write('   Maximum age: ');
           Assign(SchedFile,'SKED.DTA'); Reset(SchedFile);
           Seek(SchedFile,WorkshopChoice-1); Read(SchedFile,SchedRec);
           with SchedRec do
           begin
                GotoXY(21,10);
                Write(Workshop);
                GotoXY(21,11);
                Write(When);
                GotoXY(21,12);
                Write(Who);
                GotoXY(21,13);
                Write(HowMany);
                GotoXY(21,14);
                Write(YoungestAge);
                GotoXY(21,15);
                Write(OldestAge);
           end;
           Close(SchedFile);
           GotoXY(10,18);
           Write('Do you wish to change the listing? (Y/N) ');
           Repeat
           Read(KBD,Choice);
           Until UpCase(Choice) in ['Y','N'];  {Falls through to listings on N}
           Choic := UpCase(Choice);
           If Choic = 'Y' then
           begin
                Write(Choic);
                GotoXY(10,18);
                Write('':50);
                Assign(SchedFile,'SKED.DTA'); Reset(SchedFile);
                Seek(SchedFile,WorkshopChoice-1); Read (SchedFile,SchedRec);
                With SchedRec do
                begin
                    C := 21; {Set location, length variables before calling}
                    R := 10;
                    L := 18;
                    GetExpression;
                    Workshop := Expression;
                    C := 21;
                    R := 11;
                    L := 40;
                    GetExpression;
                    When := Expression;
                    C := 21;
                    R := 12;
                    L := 25;
                    GetExpression;
                    Who := Expression;
                    C := 21;
                    R := 13;
                    X := 3;
                    GetNumber;
                    HowMany := Number;
                    C := 21;
                    R := 14;
                    X := 3;
                    GetNumber;
                    YoungestAge := Number;
                    C := 21;
                    R := 15;
                    X := 3;
                    GetNumber;
                    OldestAge := Number;
                end;
                Seek(SchedFile,WorkshopChoice-1);
                Write(SchedFile,SchedRec);
           end;
                Close(SchedFile);
                ClrScr;
      end;



{Add or change various workshops in schedule}
procedure EditSched;
     begin
          Repeat
          EditMessage;
          ListWorkshops;
          If WorkshopChoice <> 0 then
          EditWorkshop;
          Until WorkshopChoice = 0;
     end;




{The module for creating and adding to the workshop schedule}
procedure Create;
     begin
     ClrScr;
     Assign(CheckForFile,'SKED.DTA');
     CheckForTheFile;
     If not IsOne then MakeSched else EditSched;
     end;



procedure RegistrationPrint;
          begin
               ClrScr;
               GotoXY(10,10);
               Write('Complete registration being printed...');
               Assign(PartiFile,'PARTI.DTA');
               Reset(PartiFile);
               For I := 0 to FileSize(PartiFile) - 1 do
               begin
                    Seek(PartiFile,I);Read(PartiFile, PartiRec);
                    with PartiRec do
                    begin
                         Writeln(Lst);
                         Writeln(Lst,PartiNumber);
                         Writeln(Lst,PartiName);
                         Writeln(Lst,PartiAddr1);
                         Writeln(Lst,PartiAddr2);
                         Writeln(Lst,PartiAddr3);
                         Writeln(Lst,PartiPhone);
                         Writeln(Lst,'Age: ',PartiAge);
                         If PartiIn1 > 0 then Writeln(Lst,'Is registered in: ',PartiIn1);
                         If PartiIn2 > 0 then Writeln(Lst,'Is registered in: ',PartiIn2);
                         If PartiIn3 > 0 then Writeln(Lst,'Is registered in: ',PartiIn3);
                         If PartiIn4 > 0 then Writeln(Lst,'Is registered in: ',PartiIn4);
                         If PartiIn5 > 0 then Writeln(Lst,'Is registered in: ',PartiIn5);
                         If PartiIn6 > 0 then Writeln(Lst,'Is registered in: ',PartiIn6);
                         If PartiIn7 > 0 then Writeln(Lst,'Is registered in: ',PartiIn7);
                         If PartiIn8 > 0 then Writeln(Lst,'Is registered in: ',PartiIn8);
                         If PartiIn9 > 0 then Writeln(Lst,'Is registered in: ',PartiIn9);
                         If PartiIn10 > 0 then Writeln(Lst,'Is registered in: ',PartiIn10);
                         If AltIn1 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn1);
                         If AltIn2 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn3);
                         If AltIn3 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn3);
                         If AltIn4 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn4);
                         If AltIn5 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn5);
                         If AltIn6 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn6);
                         If AltIn7 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn7);
                         If AltIn8 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn8);
                         If AltIn9 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn9);
                         If AltIn10 > 0 then Writeln(Lst,'Is an alternate in: ',AltIn10);
                         Writeln(Lst);
                         Writeln(Lst);
                   end;
               end;
               Close(PartiFile);
               Writeln(Lst,Chr(12));
          end;


procedure RosterScreen;
          begin
             ClrScr;
             Assign(SchedFile,'SKED.DTA');
             Reset(SchedFile);
             Seek(SchedFile,WorkshopChoice - 1);
             Read(SchedFile,SchedRec);
             With SchedRec do
             begin
                  J := HowMany;   {Used to screen alternates}
             end;
             R := WorkshopChoice + 10;
             Str(R:2,RosterNumber);
             RosterName := 'ROS.' + RosterNumber;
             Assign(RostListFile,RosterName);
             Reset(RostListFile);
             For I := 0 to FileSize(RostListFile) - 1 do
             begin
                   A := I +1;
                   D := A;
                   If A > 20 then if A < 41 then
                   begin
                        If A = 21 then
                        begin
                             GotoXY(4,A);
                             Write('Press space bar to list more registrants...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 20;
                   end;
                   If A > 40 then if A < 61 then
                   begin
                        If A = 41 then
                        begin
                             GotoXY(4,21);
                             Write('Press space bar to list more registrants...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 40;
                   end;
                   If A > 60 then if A < 81 then
                   begin
                        If A = 61 then
                        begin
                             GotoXY(4,21);
                             Write('Press space bar to list more registrants...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 60;
                   end;
                   Seek(RostListFile,I);Read(RostListFile,RostRec);
                   with RostRec do
                   begin
                        If AltFlag = False then
                        begin
                            GotoXY(3,A);
                            Write(PartiRosterNumber);
                            GotoXY(8,A);
                            Write(D);
                            GotoXY(12,A);
                            Write(PartiRosterName);
                            GotoXY(45,A);
                            Write(PartiRosterPhone);
                            B := I + 1;
                        end;
                  end;
            end;
            GotoXY(4,21);
            Write('Press space bar to list alternates...');
            Read(KBD,Ch);
            ClrScr;
            For I := 0 to FileSize(RostListFile) - 1 do
            begin
                   A := I +1;
                   D := A;
                   If A > 20 then if A < 41 then
                   begin
                        If A = 21 then
                        begin
                             GotoXY(4,A);
                             Write('Press space bar to list more alternates...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 20;
                   end;
                   If A > 40 then if A < 61 then
                   begin
                        If A = 41 then
                        begin
                             GotoXY(4,21);
                             Write('Press space bar to list more alternates...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 40;
                   end;
                   If A > 60 then  if A < 81 then
                   begin
                        If A = 61 then
                        begin
                             GotoXY(4,21);
                             Write('Press space bar to list more alternates...');
                             Read(KBD,Ch);
                             ClrScr;
                        end;
                        A := A - 60;
                   end;
                   Seek(RostListFile,I);Read(RostListFile,RostRec);
                   with RostRec do
                   begin
                        If AltFlag = True then
                        begin
                            GotoXY(3,A);
                            Write(PartiRosterNumber);
                            GotoXY(8,A);
                            Write(D);
                            GotoXY(12,A);
                            Write(PartiRosterName);
                            GotoXY(45,A);
                            Write(PartiRosterPhone);
                            B := I + 1;
                            GotoXY(65,A);
                            Write('**Alt');
                        end;
                  end;
           end;
           Close(RostListFile);
           GotoXY(4,A +1);
           Write('Press space bar to return to Roster listing menu...');
           Read(KBD,Ch);
           ClrScr;
      end;

procedure RosterPrint;
          begin
             ClrScr;
             Assign(SchedFile,'SKED.DTA');
             Reset(SchedFile);
             Seek(SchedFile,WorkshopChoice - 1);
             Read(SchedFile,SchedRec);
             With SchedRec do
             begin
                  J := HowMany;
                  Writeln(Lst);
                  Writeln(Lst,Workshop);
                  Writeln(Lst,When);
                  Writeln(Lst,Who);
                  Writeln(Lst,'Class limit: ',HowMany);
                  Writeln(Lst,'Minimum Age: ',YoungestAge);
                  Writeln(Lst,'Maximum Age: ',OldestAge);
                  Writeln(Lst);
                  Writeln(Lst,'Roster of those registered for class: ');
                  Writeln(Lst);
                  Writeln(Lst,'Reg #');
             end;
             Close(SchedFile);
             R := WorkshopChoice + 10;
             Str(R:2,RosterNumber);
             RosterName := 'ROS.' + RosterNumber;
             Assign(RostListFile,RosterName);
             Reset(RostListFile);
             For I := 0 to FileSize(RostListFile) - 1 do
             begin
                   Seek(RostListFile,I);Read(RostListFile,RostRec);
                   with RostRec do
                   begin
                        AltFlagger := AltFlag;
                   end;
                   If AltFlagger = False then
                   begin
                       A := I + 1;
                       D := A;
                       Seek(RostListFile,I);Read(RostListFile,RostRec);
                       with RostRec do
                       begin

                        Writeln(Lst,PartiRosterNumber:3,D:8,PartiRosterName:40,PartiRosterPhone:63);

                       end;
                   end;
             end;
             For I := 0 to FileSize(RostListFile) - 1 do
             begin
                   Seek(RostListFile,I);Read(RostListFile,RostRec);
                   With RostRec do
                   begin
                         AltFlagger := AltFlag;
                   end;
                   If AltFlagger = True then
                   begin
                       A := I + 1;
                       D := A;
                       Seek(RostListFile,I);Read(RostListFile,RostRec);
                       with RostRec do
                       begin
                            Entry := '**Alt';
                            Writeln(Lst,PartiRosterNumber:3,D:8,PartiRosterName:40,PartiRosterPhone:63,Entry:75);
                       end;
                  end;
            end;
            Close(RostListFile);
            Writeln(Lst,Chr(12));
            ClrScr;
          end;





procedure GiveRoster;
          begin
               ClrScr;
               GotoXY(1,10);
               Writeln('   Indicate that you want to see the roster on the');
               Writeln('   screen by typing <S> or on the printer by typing <P>.');
               Writeln;
               Write('   What is your choice? (S/P) ');
               Repeat
                     Read(KBD,Ch);
               Until UpCase(Ch) in ['S','P'];
               Case UpCase(Ch) of
                    'S' : RosterScreen;
                    'P' : RosterPrint;
               end;
          end;








procedure RosterChoice;
           begin
                Repeat
                     RosterMessage;
                     ListWorkshops;
                     If WorkshopChoice <> 0 then
                     GiveRoster;
                Until WorkshopChoice = 0;
           end;






procedure RosterExamine;
          begin
               ClrScr;
               RosterChoice;

          end;





procedure SelectOption;
          begin
               ClrScr;
               for I := 1 to 74 do
               begin
                    GotoXY(I,6);
                    Write(chr(205));
               end;
               GotoXY(4,2);
               Write('Select whether you would like a complete registration');
               GotoXY(4,3);
               Write('printout or you would like to examine roster listings');
               GotoXY(4,4);
               Write('by keying the appropriate letter.');
               TextColor(15);
               GotoXY(10,10);
               Write('C');
               GotoXY(10,12);
               Write('R');
               GotoXY(10,14);
               Write('X');
               TextColor(7);
               GotoXY(14,10);
               Write('Complete registration printout');
               GotoXY(14,12);
               Write('Roster listings');
               GotoXY(14,14);
               Write('Exit this function, return to menu');
               Repeat
                    Read(KBD,Choice);
               Until UpCase(Choice) in ['C','R','X'];
               Choic := UpCase(Choice);
               Case Choic of
                    'C' : RegistrationPrint;
                    'R' : RosterExamine;
               end;                  {X falls through to earlier menu}
          end;






{Examines--and prints--rosters for individual workshops}
procedure Examine;
     begin
          ClrScr;
          Assign(CheckForFile,'SKED.DTA');
          CheckForTheFile;
          If IsOne then
          begin
               Repeat
               SelectOption;
               Until Choic = 'X'
          end;
     end;


{Check to see if want a printed copy each time....and whether to form}
{feed each one}

procedure PrintOrNo;
     begin
          ClrScr;
          PrintReg := false;
          FormFeed := false;
          Writeln;
          Writeln;
          Writeln;
          Writeln('    Do you wish a printed record of each registration to');
          Write('    to be produced at the time each registration is made? (Y/N) ');
          Repeat
                Read(KBD,Ch)
          Until UpCase(Ch) in ['Y','N'];
          Write(Ch);
          If UpCase(Ch) = 'Y' then PrintReg := True;
          If UpCase(Ch) = 'Y' then
          begin
               Writeln;
               Writeln;
               Writeln('    To make the registration records print one per');
               Writeln('    page, type < F >. To make them print on a continuous');
               Write('    sheet, type  < C >. Your choice: (F,C) ');
               Repeat
                     Read(KBD,Ch)
               Until UpCase(Ch) in ['F','C'];
               Write(Ch);
               If UpCase(Ch) = 'F' then FormFeed := True;
          end;
     end;



procedure AlternateRegister;
          begin
               If NumberAltIn > MostAlternates - 1 then  {Can register as alternate only}
               begin                                     {so many times                 }
                     GotoXY(4,10);
                     Write(^G,'This workshop is full, and registrant is already       ');
                     GotoXY(4,11);
                     Write('an alternate in the maximum number of workshops.');
               end
               else
               begin
                     If NumberIn = MostWorkshops then
                     begin
                         GotoXY(4,10);
                         Write(^G,'The registrant will listed as                       ');
                     end
                     else
                     begin
                         GotoXY(4,10);
                         Write(^G,'This workshop is full. The registrant will listed as');
                     end;
                     GotoXY(4,11);
                     Write('as an alternate.                                             ');
                     If PrintReg = True then
                     begin
                          Writeln(Lst);
                          Writeln(Lst,'You are registered as an alternate in:');
                          Writeln(Lst,Entry);
                          Writeln(Lst,Expression);
                     end;
                     NumberAltIn := NumberAltIn + 1;
                     AltFlagger := True;
                     Assign(PartiFile,'PARTI.DTA'); Reset(PartiFile);
                     Z := FileSize(PartiFile) - 1;
                     Seek(PartiFile,Z);
                     With PartiRec do
                     begin
                       case NumberAltIn of         {Record registration as}
                         1 : AltIn1 := WorkshopChoice;   {an alternate}
                         2 : AltIn2 := WorkshopChoice;
                         3 : AltIn3 := WorkshopChoice;
                         4 : AltIn4 := WorkshopChoice;
                         5 : AltIn5 := WorkshopChoice;
                         6 : AltIn6 := WorkshopChoice;
                         7 : AltIn7 := WorkshopChoice;
                         8 : AltIn8 := WorkshopChoice;
                         9 : AltIn9 := WorkshopChoice;
                         10 : AltIn10 := WorkshopChoice;
                       end;
                       Write(PartiFile,PartiRec);
                    end;
                    Close(PartiFile);
                    Assign(PartiFile,'PARTI.DTA');Reset(PartiFile);
                    Seek(PartiFile,FileSize(PartiFile) - 1);
                    Read(PartiFile,PartiRec);
                    with PartiRec do
                    begin
                         V := PartiNumber;
                    end;
                    Close(PartiFile);
                    Assign(RostListFile,RosterName);Reset(RostListFile);
                    Seek(RostListFile,R);
                    With RostRec do
                    begin
                         PartiRosterNumber := V;
                         PartiRosterName := PartiNameHold;
                         PartiRosterPhone := PartiPhoneHold;
                         AltFlag := AltFlagger;
                    end;
                    Write(RostListFile,RostRec);
                    Close(RostListFile);
               end;
          end;








procedure Transfer;
    begin
          Okay := False;
          AgeSkip := False;
          Repeat
           Repeat
             GotoXY(4,10);
             Write('':69);
             GotoXY(4,11);
             Write('':69);
             GotoXY(4,9);
             Write('':69);
             GotoXY(4,9);
             Write('Enter the number of the workshop desired:               ');
             C := 60; R := 9; X := 2;
             GetNumber; WorkshopChoice := Number;
             If WorkshopChoice > 45 then Write(^G);
             If WorkshopChoice < 1 then Write(^G);
             Yes := False;
             If WorkshopChoice < 46 then if WorkshopChoice > 0 then Yes := True;
           Until Yes = True;
           Assign(SchedFile, 'SKED.DTA'); Reset(SchedFile);
           Seek(SchedFile,WorkshopChoice - 1);Read(SchedFile,SchedRec);
           With SchedRec do
           begin
                Entry := Workshop;
                Expression := When;
                Y := YoungestAge;
                O := OldestAge;
                L := HowMany;
           end;
           Close(SchedFile);
           H := PartiAgeHold;
           If PartiAgeHold > O then
           begin
                GotoXY(4,10);
                Write(^G,'The registrant is too old for this workshop. Press');
                GotoXY(4,11);
                Write('Do you wish to register for another workshop? (Y/N) ');
                Repeat
                     Read(KBD,Ch);
                Until UpCase(Ch) in ['Y','N','X'];
                Write(UpCase(Ch));
                If UpCase(Ch) = 'X' then   {Allow operator override without showing}
                begin              {that option on the screen.}
                     H := O;
                     GotoXY(4,10);
                     Write(^G,'Age mismatch overridden by registrar...                 ');
                     GotoXY(4,11);
                     Write('Registration process continues...                      ');
                     Delay(3500);
                end;
                If UpCase(Ch) = 'N' then
                begin
                     Stopper := True;
                     AgeSkip := True;
                     H := O;
                end;
           end;
           If PartiAgeHold < Y then
           begin
                GotoXY(4,10);
                Write(^G,'The registrant is too young for this workshop.      ');
                GotoXY(4,11);
                Write('Do you wish to register for another workshop? (Y/N) ');
                Repeat
                     Read(KBD,Ch);
                Until UpCase(Ch) in ['Y','N','X'];
                Write(UpCase(Ch));
                If UpCase(Ch) = 'X' then
                begin
                     H := Y;
                     GotoXY(4,10);
                     Write(^G,'Age mismatch overridden by registrar...             ');
                     GotoXY(4,11);
                     Write('Registration process continues...                      ');
                     Delay(3500);
                end;
                If UpCase(Ch) = 'N' then
                begin
                     Stopper := True;
                     AgeSkip := True;
                     H := Y;
               end;
           end;
           If O >= H then if H >= Y then Okay := True;
          Until Okay = True;
  {**} If AgeSkip = False then
       begin
          J := WorkshopChoice + 10;
          Str(J:2,RosterNumber);
          RosterName := 'ROS.' + RosterNumber;
          Assign(RostListFile,RosterName); Reset(RostListFile);
          R := FileSize(RostListFile);
          Close(RostListFile);
          B := R + 1;
          If B > L then if NumberAltIn <> MostAlternates then
          begin
               AlternateRegister;
          end
          else
          begin
               GotoXY(4,10);
               Write('The workshop is full and the registrant is already     ');
               GotoXY(4,11);
               Write('an alternate in the maximum number of workshops.       ');
          end;
          If B <= L then if NumberIn = MostWorkshops then AlternateRegister;
          If B <= L then if NumberIn <> MostWorkshops then
          begin
                     NumberIn := NumberIn + 1;
                     AltFlagger := False;
                     Assign(PartiFile,'PARTI.DTA'); Reset(PartiFile);
                     Z := FileSize(PartiFile) - 1;
                     Seek(PartiFile,Z);
                     With PartiRec do
                     begin
                       case NumberIn of
                         1 : PartiIn1 := WorkshopChoice;
                         2 : PartiIn2 := WorkshopChoice;
                         3 : PartiIn3 := WorkshopChoice;
                         4 : PartiIn4 := WorkshopChoice;
                         5 : PartiIn5 := WorkshopChoice;
                         6 : PartiIn6 := WorkshopChoice;
                         7 : PartiIn7 := WorkshopChoice;
                         8 : PartiIn8 := WorkshopChoice;
                         9 : PartiIn9 := WorkshopChoice;
                         10 : PartiIn10 := WorkshopChoice;
                       end;
                       Write(PartiFile,PartiRec);
                    end;
                    Close(PartiFile);
                    Assign(PartiFile,'PARTI.DTA');Reset(PartiFile);
                    Seek(PartiFile,FileSize(PartiFile) - 1);
                    Read(PartiFile,PartiRec);
                    With PartiRec do
                    begin
                        V := PartiNumber;
                    end;
                    Close(PartiFile);
                    Assign(RostListFile,RosterName);Reset(RostListFile);
                    Seek(RostListFile,R);
                    With RostRec do
                    begin
                         PartiRosterNumber := V;
                         PartiRosterName := PartiNameHold;
                         PartiRosterPhone := PartiPhoneHold;
                         AltFlag := AltFlagger;
                    end;
                    Write(RostListFile,RostRec);
                    Close(RostListFile);
                    GotoXY(4,11);
                    Write('Registration successful...                                  ');
                    If PrintReg = False then
                    begin
                         Delay(3000);
                         Write(^G);
                    end;
                    If PrintReg = True then
                    begin
                         Writeln(Lst);
                         Writeln(Lst,'You are registered in: ');
                         Writeln(Lst,Entry);
                         Writeln(Lst,Expression);
                    end;
          end;
          If NumberIn = MostWorkshops then if NumberAltIn = MostAlternates then
          begin
               GotoXY(4,11);
               Write('':69);
               GotoXY(4,10);
               Write('':69);
               Stopper := True;
          end;
          If NumberIn = MostWorkshops then if NumberAltIn <> MostAlternates then
          begin
               GotoXY(4,10);
               Write('You have register successfully for the maximum');
               GotoXY(4,11);
               Write('number of workshops, but may still be listed as an');
               GotoXY(4,12);
               Write('alternate if you wish to register for another workshop.');
               GotoXY(4,13);
               Write('Do you wish to register for another workshop? (Y/N) ');
               Repeat
                  Read(KBD,Ch);
               Until UpCase(Ch) in ['Y','N'];
               Write (UpCase(Ch));
               If UpCase(Ch) = 'N' then Stopper := True;
               If UpCase(Ch) = 'Y' then
               begin
                         GotoXY(4,12);
                         Write('':69);
                         GotoXY(4,13);
                         Write('':69);
              end;
          end;
          If NumberIn <> MostWorkshops then
          begin
               GotoXY(4,13);
               Write('Do you wish to register for another workshop? (Y/N) ');
               Repeat
                     Read(KBD,Ch);
               Until UpCase(Ch) in ['Y','N'];
               Write(UpCase(Ch));
               If UpCase(Ch) = 'N' then Stopper := True;
               If UpCase(Ch) = 'Y' then
               begin
                    GotoXY(4,12);
                    Write('':69);
                    GotoXY(4,13);
                    Write('':69);
               end;
          end;
{**}    end;
    end;



procedure RegisterParti;
     begin
       PrintOrNo;{find out whether to turn printer on}
       Stopper := False;
       Repeat
         Stopper := False;
         ClrScr;
         Writeln;
         Writeln('    Registrant''s Name: '); {Get input of name, etc.}
         Writeln('              Address: ');
         Writeln('              Address: ');
         Writeln('              Address: ');
         Writeln('            Telephone: ');
         Writeln('                  Age: ');
         Writeln;
         C := 24;
         R := 2;
         L := 30;
         GetExpression;
         PartiNameHold := Expression;
         C := 24;
         R := 3;
         L := 30;
         GetExpression;
         PartiAddr1Hold := Expression;
         C := 24;
         R := 4;
         L := 30;
         GetExpression;
         PartiAddr2Hold := Expression;
         C := 24;
         R := 5;
         L := 30;
         GetExpression;
         PartiAddr3Hold := Expression;
         C := 24;
         R := 6;
         L := 14;
         GetExpression;
         PartiPhoneHold := Expression;
         C := 24;
         R := 7;
         X := 3;
         GetNumber;
         PartiAgeHold := Number;
         Assign(PartiFile,'PARTI.DTA');Reset(PartiFile);
         Seek(PartiFile,FileSize(PartiFile));
         With PartiRec do
         begin
              PartiNumber := FileSize(PartiFile) + 1;
              PartiName := PartiNameHold;
              PartiAddr1 := PartiAddr1Hold;
              PartiAddr2 := PartiAddr2Hold;
              PartiAddr3 := PartiAddr3Hold;
              PartiPhone := PartiPhoneHold;
              PartiAge := PartiAgeHold;
              PartiIn1 := 0;
              PartiIn2 := 0;
              PartiIn3 := 0;
              PartiIn4 := 0;
              PartiIn5 := 0;
              PartiIn6 := 0;
              PartiIn7 := 0;
              PartiIn8 := 0;
              PartiIn9 := 0;
              PartiIn10 := 0;
              AltIn1 := 0;
              AltIn2 := 0;
              AltIn3 := 0;
              AltIn4 := 0;
              AltIn5 := 0;
              AltIn6 := 0;
              AltIn7 := 0;
              AltIn8 := 0;
              AltIn9 := 0;
              AltIn10 := 0;
         end;
         Write(PartiFile,PartiRec);
         Close(PartiFile);
         NumberIn := 0;      {Start counters of number of registrations}
         NumberAltIn := 0;
         Assign(LimitFile,'LIMITS.DTA');Reset(LimitFile);
         Seek(LimitFile,FileSize(LimitFile) - 1);
         Read(LimitFile,LimitRec);
         With LimitRec do
         begin
              MostWorkshops := WorkshopLimit;
              MostAlternates := AlternateLimit;
         end;
         Close(LimitFile);
         If PrintReg = True then
         begin
              Writeln(Lst,PartiNameHold);
              Writeln(Lst,PartiAddr1Hold);
              Writeln(Lst,PartiAddr2Hold);
              Writeln(Lst,PartiAddr3Hold);
              Writeln(Lst,PartiPhoneHold);
         end;
         Repeat
         Transfer;
         Until Stopper = True;
         If PrintReg = True then
         begin
              If FormFeed = True then
              Write(Lst,Chr(12))
              else
              Writeln(Lst);
              Writeln(Lst);
         end;
         GotoXY(4,10);
         Write(^G,'This completes the registration for this registrant.   ');
         GotoXY(4,11);
         Write('':69);
         GotoXY(4,11);
         Write('Do you wish to register another participant? (Y/N) ');
         GotoXY(4,12);
         Write('':69);
         GotoXY(4,13);
         Write('':69);
         Repeat
               Read(KBD,Ch);
         Until UpCase(Ch) in ['Y','N'];
         Write(Ch);
      Until UpCase(Ch) = 'N';
     end;











{Module to register participants in workshops...makes them alternates}
{if desired workshop is filled}
procedure Register;
     begin
          ClrScr;
          Assign(CheckForFile,'SKED.DTA');
          CheckForTheFile;
          If not IsOne then MakeSched else RegisterParti;

     end;






{The opening menu. Return to this procedure at the end of each}
{module of SIGN UP! Use TextColor change to get high video.   }

procedure OpenMenu;
     begin
     ClrScr;
     Writeln;
     Writeln;
     Writeln('         Choose from the following SIGN UP! program options');
     Writeln('         by keying the letter corresponding to your choice.');
     Writeln('         Example: Type "Q" to quit.');
     for I := 1 to 74 do
     begin
     GotoXY(I,7);
     Write(chr(205));
     end;
     TextColor(15);
     GotoXY(10,9);
     Write('C');
     GotoXY(10,11);
     Write('E');
     GotoXY(10,13);
     Write('R');
     GotoXY(10,15);
     Write('Q');
     TextColor(7);
     GotoXY(15,9);
     Write('Create, view or edit a workshop schedule');
     GotoXY(15,11);
     Write('Examine or print a workshop roster or regristant list');
     GotoXY(15,13);
     Write('Register participants in workshops');
     GotoXY(15,15);
     Write('Quit SIGN UP! (Return to DOS)');
     end;


procedure ChooseMenu;
     begin
     Repeat
     Read(KBD,Choice)
     Until UpCase(Choice) in ['C','E','R','Q'];
     Choic := UpCase(Choice);
     Case Choic of
     'C': Create;
     'E': Examine;
     'R': Register; {Q falls through to program block, hence to DOS}
     end;
     end;


{The choice of which module made here}
procedure ChooseModule;
     begin
     OpenMenu;
     ChooseMenu;
     end;


{The program}
begin
     Intro;
     Repeat
     ChooseModule
     Until Choic = 'Q';
     ClrScr;
end.